R - Shiny

class: center, middle, inverse, title-slide

# L’Extension : Shiny
## Mes Premiers Pas
### Mickaël Canouil, Ph.D. (<a href="http://m.canouil.fr/" target="_blank"> m.canouil.fr</a>)
### Dernière mise à jour : 26-03-2021

---

class: part-slide

@-webkit-keyframes glow {
 from {
 /*text-shadow: 0 0 10px #fff, 0 0 20px #fff, 0 0 30px #1b81e5, 0 0 40px #1b81e5, 0 0 50px #1b81e5, 0 0 60px #1b81e5, 0 0 70px #1b81e5;*/
 }
 to {
 text-shadow: 0 0 20px #a9a9a9, 0 0 30px #a9a9a9, 0 0 40px #a9a9a9, 0 0 50px #a9a9a9;
 }
}
</style>

# Diapositives et matériel [ mcanouil/rshiny](https://github.com/mcanouil/rshiny/)

---
class: part-slide

# Préparer sa session

---

# Trucs et astuces

* Eviter de changer votre répertoire de travail avec `setwd()`.
* Ne pas utiliser de `.Rprofile` modifiant .
* Désactiver la conversion automatique en facteurs `options(stringsAsFactors = FALSE)`.
* Ne pas utiliser `rm(list = ls())` pour "rafraichir".
* Ne pas utiliser la sauvegarde/restauration par défaut de .

.pull-left[
.center[
![](data:image/png;base64,#images/rstudio_setup.png)
]
]

.pull-right[
.center[
![](data:image/png;base64,#images/rwindows_setup.png)
]
]

---
class: part-slide

# Qu'est-ce que Shiny ? <img src = "data:image/png;base64,#images/shiny.png", width = "216px" />

---

# Avant Shiny ...

Il était nécessaire de connaître/maîtriser :

* **HTML**, pour concevoir des pages (statique) web.

* **CSS**, pour ajouter du _style_ à une page HTML.

* **JavaScript**, pour effectuer des "calculs" au sein d'une page HTML (via un navigateur).

---

# Shiny

Shiny est une extension permettant la création d'application web interactive directement depuis .

* Page internet.

* Documents (R Markdown) interactifs.

* Tableaux de bords.

Les applications Shiny sont compatibles avec :

* CSS.

* "html widgets".

* JavaScript.

---

# Installation & Chargement

La version stable de Shiny peut se télécharger sur le CRAN.

```r
install.packages("shiny")
```

La version en développement est disponible sur GitHub .

```r
if (!require("remotes")) install.packages("remotes")
remotes::install_github("rstudio/shiny")
```

Charger Shiny dans sa session .

```r
library("shiny")
```

---

# Composantes d'une application Shiny

+ L'extension Shiny.
    
    ```r
    library("shiny")
    ```

+ Une interface (`ui`, *i.e.*, "user interface").
 
 ```r
 ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")
 ```

+ Une fonction serveur (`server`).
 
 ```r
 server <- function(input, output, session) { }
 ```

+ La construction d'un objet "Shiny app".
    
    ```r
    shinyApp(ui, server)
    ```

???

App [`"materials/00-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/00-app/app.R)

---

# Composantes d'une application Shiny

L'application Shiny peut être démarrée par simple exécution.

```r
library("shiny")

ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")

server <- function(input, output, session) { }

shinyApp(ui, server)
```

???

App [`"materials/00-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/00-app/app.R)

---

# Composantes d'une application Shiny

Ou via un script `app.R`, placé dans un répertoire portant généralement le nom de l'application.

```{}
materials/00-app
\-- app.R
```

```r
library("shiny")

ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")

server <- function(input, output, session) { }

shinyApp(ui, server)
```

```r
runApp("materials/00-app")
```

???

App [`"materials/00-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/00-app/app.R)

---

# Composantes d'une application Shiny

Une fois l'application démarrée, vous devriez voir une fenêtre s'ouvrir.

```r
runApp("materials/00-app")
```

```r
#> Listening on http://127.0.0.1:4550
```

???

App [`"materials/00-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/00-app/app.R)

* URL par défaut (hôte)

* Port défini au hasard

* Console R "occupée"

* Bouton "stop"

* `Ctrl`+ `c`

* Fermer la fenêtre de l'application

---

# L'interface `ui`

* `fluidPage()`, la fonction gérant la structure de la page internet ("responsive web design").

```r
ui <- fluidPage("Bonjour, vous êtes sur une application Shiny !")
```

Pour ajouter des contrôles (`*Input()`).

* `textInput()`, la fonction gérant un champ de saisie de texte.

```r
  textInput(inputId = "name", label = "Nom", value = "default")
```

```r
ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default")
)
```

???

App [`"materials/01-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/01-app/app.R)

---

# L'interface `ui`

Les contrôles (`*Input()`) nativement disponibles :

.pull-left[

* `checkboxGroupInput()`

* `checkboxInput()`

* `dateInput()`

* `dateRangeInput()`

* `fileInput()`

* `numericInput()`

]

.pull-right[

* `passwordInput()`

* `selectInput()`

* `selectizeInput()`

* `sliderInput()`

* `textAreaInput()`

* `textInput()`

]

---

# L'interface `ui`

```r
runApp("materials/01-app")
```

```r
#> Listening on http://127.0.0.1:4550
```

???

App [`"materials/01-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/01-app/app.R)

---

# Le serveur `server`

Notre application ne contient aucune action serveur (`server`).

```r
library("shiny")

ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default")
)

server <- function(input, output, session) { }

shinyApp(ui, server)
```

???

App [`"materials/01-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/01-app/app.R)

---

# Le serveur `server`

* Du `server` à `ui` $\rightarrow$ `output`.

```r
server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}
```

```r
output$id <- renderTYPE({
 # Une expression générant la sortie de type "TYPE"
})
```

* Partie _gauche_ : objet (`output`) renvoyé vers l'interface (`ui`) avec un identifiant unique (`id`).

* Partie _droite_ : fonction spécifique pour générer la sortie qui pourra être affichée dans l'interface (`ui`).

???

App [`"materials/02-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/02-app/app.R)

---

# Le serveur `server`

Les fonctions `render*()` nativement disponibles :

* `renderCachedPlot()`

* `renderDataTable()`

* `renderImage()`

* `renderPlot()`

* `renderPrint()`

* `renderTable()`

* `renderText()`

* `renderUI()`

---

# Le serveur `server`

* Du `server` à `ui` $\rightarrow$ `output`.

```r
server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}
```

* `textOutput()`, la fonction gérant l'affichage des éléments construits par le serveur (`server`).

```r
library("shiny")

ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default"),
 textOutput(outputId = "hello_message")
)

server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}

shinyApp(ui, server)
```

???

App [`"materials/02-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/02-app/app.R)

---

# Première application Shiny

```r
library("shiny")

ui <- fluidPage(
 textInput(inputId = "name", label = "Nom", value = "default"),
 textOutput(outputId = "hello_message")
)

server <- function(input, output, session) {
 output$hello_message <- renderText("Bonjour")
}

shinyApp(ui, server)
```

???

App [`"materials/02-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/02-app/app.R)

---

# Première application Shiny

```r
runApp("materials/02-app")
```

```r
#> Listening on http://127.0.0.1:4550
```

???

App [`"materials/02-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/02-app/app.R)

# Les `input` en détails

Contraintes sur les valeurs de `inputID` :

* Doit être unique.

* Chaîne de caractères alphanumériques et "underscores".

???

App [`"materials/02-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/02-app/app.R)

---

# `input` de type texte

```r
ui <- fluidPage(
 textInput("name", "Nom"),
 passwordInput("password", "Mot de passe"),
 textAreaInput("description", "Description", rows = 3)
)
```

???

App [`"materials/03-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/03-app/app.R)

---

# `input` de type numérique

```r
ui <- fluidPage(
 numericInput("num1", "Nombre 1", value = 0, min = 0, max = 100),
 sliderInput("num2", "Nombre 2", value = 42, min = 0, max = 100),
 sliderInput("rng", "Gamme", value = c(7, 42), min = 0, max = 100)
)
```

???

App [`"materials/04-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/04-app/app.R)

---

# `input` de type date

```r
ui <- fluidPage(
 dateInput("uniq_date", "Date unique"),
 dateRangeInput("period", "Période")
)
```

???

App [`"materials/05-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/05-app/app.R)

---

# `input` de sélection simple

```r
ui <- fluidPage(
 selectInput("letters", "Lettres minuscules", head(letters)),
 radioButtons("letters2", "Lettres majuscules", LETTERS[1:5])
)
```

???

App [`"materials/06-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/06-app/app.R)

---

# `input` de sélection multiple

```r
ui <- fluidPage(
 checkboxInput(
 "bin1", 'Question binaire ("oui" par défaut)', value = TRUE
 ),
 checkboxInput("bin2", 'Question binaire ("non" par défaut)'),
 checkboxGroupInput("letters3", "Plusieurs Lettres", LETTERS[5:1])
)
```

???

App [`"materials/07-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/07-app/app.R)

---

# `input` d'action

```r
ui <- fluidPage(
 fileInput("upload", NULL),
 actionButton("click", "Cliquez ici !", icon = icon("mouse-pointer")),
 p( actionLink("click", "Cliquez ici !", icon = icon("home")) )
)
```

_Note : `icon()` utilise la bibliothèque d'icônes [Font Awesome](https://fontawesome.com/)._

???

App [`"materials/08-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/08-app/app.R)

---

# Mise en pratique

* Essayez les différents `input` en jouant sur les arguments.

* Créez un fomulaire : nom, prénom, age, sexe, loisirs (choix multiples).

???

App [`"materials/09-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/09-app/app.R)

---

# Mise en pratique

* Créez un fomulaire : nom, prénom, age, sexe, loisirs (choix multiples).

```r
ui <- fluidPage(
 textInput("lastname", "Nom", value = ""),
 textInput("firstname", "Prénom", value = ""),
 numericInput("age", "Age", value = 0),
 radioButtons("sex", "Sexe", 
 choices = c("Femme", "Homme", "Ne sait pas"), 
 selected = "Ne sait pas"
 ),
 checkboxGroupInput("hobbies", "Loisirs", 
 choices = c("Vélo", "Rando", "Natation", "Badminton", "Autres")
 )
)
```

???

App [`"materials/09-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/09-app/app.R)

---

# Mise en pratique

* Créez un fomulaire : nom, prénom, age, sexe, loisirs (choix multiples).

???

App [`"materials/09-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/09-app/app.R)

#  Les `output` en détails

```r
}
```

Contraintes sur les valeurs de `outputId` :

* Doit être unique.

* Chaîne de caractères alphanumériques et "underscores".

???

App [`"materials/02-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/02-app/app.R)

---

# `output` de type texte

```r
library("shiny")

ui <- fluidPage(
 ###
 textOutput("text"),
 verbatimTextOutput("code")
 ###
)

server <- function(input, output, session) {
 ###
 output$text <- renderText({ 
 ###
 "Bonjour, vous êtes sur une application Shiny !"
 ###
 })
 output$code <- renderPrint({ 
 ###
 summary(rnorm(10))
 ###
 })
 ###
}

shinyApp(ui, server)
```

???

App [`"materials/10-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/10-app/app.R)

---

# `output` de type texte

```r
ui <- fluidPage(
 ###
 textOutput("text"),
 verbatimTextOutput("code")
 ###
)
server <- function(input, output, session) {
 ###
 output$text <- renderText({ 
 ###
 "Bonjour, vous êtes sur une application Shiny !"
 ###
 })
 output$code <- renderPrint({ 
 ###
 summary(rnorm(10))
 ###
 })
 ###
}
```

???

App [`"materials/10-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/10-app/app.R)

---

# `output` de type texte

```r
ui <- fluidPage(
 ###
 textOutput("text"),
 textOutput("code")
 ###
)
server <- function(input, output, session) {
 ###
 output$text <- renderText({ 
 ###
 "Du texte"
 ###
 })
 output$code <- renderPrint({ 
 ###
 "Du code"
 ###
 })
 ###
}
```

???

App [`"materials/11-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/11-app/app.R)

---

# `output` de type texte

```r
ui <- fluidPage(
 ###
 verbatimTextOutput("text"),
 verbatimTextOutput("code")
 ###
)

server <- function(input, output, session) {
 ###
 output$text <- renderText({ summary(rnorm(10)) })
 output$code <- renderPrint({ summary(rnorm(10)) })
 ###
}
```

???

App [`"materials/12-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/12-app/app.R)

---

# `output` de type tableau statique

```r
ui <- fluidPage(
 ###
 tableOutput("static")
 ###
)
server <- function(input, output, session) {
 ###
 output$static <- renderTable(expr = head(swiss, 5))
 ###
}
```

???

App [`"materials/13-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/13-app/app.R)

---

# `output` de type tableau dynamique

```r
ui <- fluidPage(
 ###
 dataTableOutput("dynamic")
 ###
)

server <- function(input, output, session) {
 ###
 # Light version of DT::renderDataTable (server side)
 output$dynamic <- renderDataTable(
 expr = swiss, options = list(pageLength = 2)
 )
 ###
```

???

App [`"materials/14-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/14-app/app.R)

---

# `output` de type image (`base`)

```r
ui <- fluidPage(
 ###
 plotOutput("plot", height = "300px")
 ###
)

server <- function(input, output, session) {
 ###
 output$plot <- renderPlot(plot(1:5))
 ###
}
```

???

App [`"materials/15-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/15-app/app.R)

---

# `output` de type image (`ggplot2`)

```r
library("ggplot2")
ui <- fluidPage(
 ###
 plotOutput("plot", height = "200px")
 ###
)

server <- function(input, output, session) {
 ###
 output$plot <- renderPlot(
 ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point()
 )
 ###
}
```

???

App [`"materials/16-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/16-app/app.R)

---

# Mise en pratique

* Créez un fomulaire : nom, prénom, age, sexe, loisirs (choix multiples).  
  (*Formulaire générer précedemment*)

* Ajoutez une phrase de bienvenue aléatoire depuis le `server`.

* Créez une application affichant un graphique et son code.

???

App [`"materials/09-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/09-app/app.R)

App [`"materials/17-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/17-app/app.R)

App [`"materials/18-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/18-app/app.R)

---

# Mise en pratique

* Créez un fomulaire : nom, prénom, age, sexe, loisirs (choix multiples).  
  (*Formulaire généré précedemment*)

???

App [`"materials/09-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/09-app/app.R)

---

# Mise en pratique

* Ajoutez une phrase de bienvenue aléatoire depuis le `server`.

```r
ui <- fluidPage(
 textInput("lastname", "Nom", value = "Nom"),
 textInput("firstname", "Prénom", value = "Prénom"),
 ###
 textOutput("greetings"),
 ###
 numericInput("age", "Age", value = 0),
 radioButtons("sex", "Sexe", 
 choices = c("Femme", "Homme", "Ne sait pas"), 
 selected = "Ne sait pas"
 ),
 checkboxGroupInput("hobbies", "Loisirs", 
 choices = c("Vélo", "Rando", "Natation", "Badminton", "Autres")
 )
)
```

???

App [`"materials/17-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/17-app/app.R)

---

# Mise en pratique

* Ajoutez une phrase de bienvenue aléatoire depuis le `server`.

```r
server <- function(input, output, session) { 
 ###
 output$greetings <- renderText({ 
 sample(c(
 "Bonjour !", "Bienvenue !", "Hello !", 
 "Salutations !", "Comment allez-vous ?",
 "Heu, vous êtes qui ?"
 ), 1)
 })
 ###
}
```

???

App [`"materials/17-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/17-app/app.R)

---

# Mise en pratique

* Ajoutez une phrase de bienvenue aléatoire depuis le `server`.
 
<img src="data:image/png;base64,#D:/Profils/mcanouil/PROJECTS/mc-rshiny/images/17.png" width="1200" style="display: block; margin: auto;" />

???

App [`"materials/17-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/17-app/app.R)

---

# Mise en pratique

* Créez une application affichant un graphique et son code.

```r
code_for_plot <- "plot(1:10)"

ui <- fluidPage(
 verbatimTextOutput("code"),
 plotOutput("plot")
)

server <- function(input, output, session) { 
 output$code <- renderText({ 
 code_for_plot
 })
 output$plot <- renderPlot({ 
 eval(parse(text = code_for_plot))
 })
}
```

???

App [`"materials/18-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/18-app/app.R)

---

# Mise en pratique

* Créez une application affichant un graphique et son code.
 
<img src="data:image/png;base64,#D:/Profils/mcanouil/PROJECTS/mc-rshiny/images/18.png" width="1200" style="display: block; margin: auto;" />

???

App [`"materials/18-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/18-app/app.R)

#  La mise en page "sidebar"

---

# La mise en page "sidebar" en code

```r
###
ui <- fluidPage(
 titlePanel("Un titre !"),
 sidebarLayout(
 sidebarPanel(
###
 sliderInput("point", "Point :", min = 0, max = 20, value = 5)
###
 ),
 mainPanel(
###
 plotOutput("plot", height = "500px")
###
 )
 )
)
###
```

???

App [`"materials/19-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/19-app/app.R)

---

# La mise en page "sidebar" en image

???

App [`"materials/19-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/19-app/app.R)

---

# La mise en page "multirow"

---

# La mise en page "multirow" en code

```r
###
ui <- fluidPage(
 fluidRow(
 column(width = 4, 
###
 sliderInput("point", "Point :", min = 0, max = 20, value = 5)
###
 ),
 column(width = 8, plotOutput("plot"))
 ),
 fluidRow(
 column(width = 6, 
###
 sliderInput("mean", "Moyenne :", min = 0, max = 2, value = 1)
###
 ),
 column(width = 6, plotOutput("plot2"))
 )
)
###
```

???

App [`"materials/20-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/20-app/app.R)

---

# La mise en page "multirow" en image

???

App [`"materials/20-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/20-app/app.R)

---

# La mise en page "tabset" en code

```r
###
ui <- navbarPage("App Title",
 tabPanel("Figures", 
 tabsetPanel(
 tabPanel("point", plotOutput("plot")),
 tabPanel("Densité", plotOutput("plot2"))
 )
 ),
 tabPanel("Table", tableOutput("desc"))
)
###
```

???

App [`"materials/21-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/21-app/app.R)

---

# La mise en page "tabset" en image

???

App [`"materials/21-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/21-app/app.R)

---

# La mise en page "dashboard" en code

```r
library("shinydashboard")

###
ui <- dashboardPage(
 dashboardHeader(),
 dashboardSidebar(),
 dashboardBody()
)
###
```

???

App [`"materials/22-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/22-app/app.R)

---

# La mise en page "dashboard" en image

???

App [`"materials/22-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/22-app/app.R)

---

# La mise en page "dashboard" en code

```r
###
ui <- dashboardPage(
 dashboardHeader(title = "Shiny App"),
 dashboardSidebar(
###
 textInput("title", "Titre :", value = "Titre"),
 sliderInput("point", "Point :", min = 0, max = 20, value = 5),
 sliderInput("mean", "Moyenne :", min = 0, max = 2, value = 1)
###
 ),
 dashboardBody(
 fluidRow(
 box(plotOutput("plot"), width = 6),
 box(title = "Density", plotOutput("plot2"), width = 6)
 )
 )
)
###
```

???

App [`"materials/23-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/23-app/app.R)

---

# La mise en page "dashboard" en image

???

App [`"materials/23-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/23-app/app.R)

---

# Mise en pratique

* Essayez la structure grille avec `fluidPage()`, `fluidRow()`, `fixedRow()` et `column()`.

* Reproduisez les interfaces suivantes.

.center[

]

???

App [`"materials/24-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/24-app/app.R)

App [`"materials/25-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/25-app/app.R)

---

# Mise en pratique

* Reproduisez l'interface suivante.

???

App [`"materials/24-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/24-app/app.R)

---

# Mise en pratique

* Reproduisez l'interface suivante.

```r
ui <- fluidPage(titlePanel("Bienvenue"),
 sidebarLayout(
 sidebarPanel(
 textInput("lastname", "Nom", value = ""),
 textInput("firstname", "Prénom", value = ""),
 numericInput("age", "Age", value = 0),
 ),
 mainPanel(
 tabsetPanel(
 tabPanel("Plot", plotOutput("plot")), 
 tabPanel("Code", verbatimTextOutput("code"))
 )
 )
 )
)
```

???

App [`"materials/24-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/24-app/app.R)

---

# Mise en pratique

* Reproduisez l'interface suivante.

???

App [`"materials/25-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/25-app/app.R)

---

# Mise en pratique

* Reproduisez l'interface suivante.

```r
ui <- fluidPage(
 titlePanel("Bienvenue"),
 navlistPanel(
 "Partie A",
 tabPanel("Plot 1", plotOutput("plot1")),
 tabPanel("Code 1", verbatimTextOutput("code1")),
 "Partie B",
 tabPanel("Plot 2", plotOutput("plot2")),
 tabPanel("Code 2", verbatimTextOutput("code2"))
 )
)
```

???

App [`"materials/25-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/25-app/app.R)

# La fonction `server`

```r
server <- function(
 ###
 input, 
 output, 
 session
 ###
) {
 ...
}
```

* `input`, une liste de paramètres d'entrées.
* `output`, une liste d'objets à afficher dans `ui`.
* `session`, environnement relatif à la session,  
    *c.-à-d.*, la connection.

---

# La fonction `server`

* De `ui` au `server` $\rightarrow$ `input`.

```r
ui <- fluidPage(
 textInput(
 ###
 inputId = "text",
 ###
 label = "Texte : ", value = "Du texte par défaut ..."
 ),
 textOutput("text")
)
```

```r
server <- function(input, output, session) {
 output$text <- renderText({
 ###
 input$text
 ###
 })
}
```

???

App [`"materials/26-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/26-app/app.R)

---

# La fonction `server`

???

App [`"materials/26-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/26-app/app.R)

---

# La liste d'entrées `input`

* `input`, une liste de paramètres d'entrées __non-modifiable__.

```r
library("shiny")

ui <- fluidPage(
 textInput("text", "Texte : "),
 textOutput("text")
)

server <- function(input, output, session) {
 ###
 input$text <- "Du texte par défaut ..."
 ###
 output$text <- renderText({ input$text })
}

shinyApp(ui, server)
```

???

App [`"materials/27-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/27-app/app.R)

---

# La liste d'entrées `input`

* `input`, une liste de paramètres d'entrées "__reactive__".

```r
library("shiny")
ui <- fluidPage(
 textInput("text", "Texte : "),
 p(
 "Le texte saisi est : ", 
 textOutput("text", inline = TRUE)
 )
)
server <- function(input, output, session) {
 ###
 message("Le texte saisi est : ", input$text)
 ###
 output$text <- renderText({ input$text })
}
shinyApp(ui, server)
```

???

App [`"materials/29-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/29-app/app.R)

---

# La liste de sorties `output`

* `output`, une liste __non-modifiable__ d'objets à afficher dans `ui`.

```r
library("shiny")

ui <- fluidPage(
 textInput("text", "Texte : "),
 textOutput("text")
)

server <- function(input, output, session) {
 output$text <- renderText({ input$text })
 ###
 output$text <- "Du texte par défaut ..."
 ###
}

shinyApp(ui, server)
```

???

App [`"materials/30-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/30-app/app.R)

---

# La liste de sorties `output`

* `output`, une liste "__reactive__" d'objets à afficher dans `ui`.

```r
library("shiny")
ui <- fluidPage(
 textInput("text", "Texte : "),
 p(
 "Le texte saisi est : ", 
 textOutput("text", inline = TRUE)
 )
)
server <- function(input, output, session) {
 output$text <- renderText({ input$text })
 ###
 message("Le texte saisi est : ", output$text)
 ###
}
shinyApp(ui, server)
```

???

App [`"materials/31-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/31-app/app.R)

---

# La notion de réactivité `reactive`

Les sorties (`output`) sont mises à jour à la volée par Shiny lorsque les entrées (`input`) sont modifiées.

* La fonction `server` renseigne Shiny sur la __façon__ de produire les sorties.

* Shiny "décide" de __quand__ produire les sorties.

* Shiny n'exécute que les morceaux de code __utiles__.

---

# La notion de réactivité `reactive`

```r
library("shiny")
ui <- fluidPage(
 textInput("text", "Texte : ", value = "vide"),
 p("Texte 1 : ", textOutput("text", inline = TRUE)),
 p("Texte 2 : ", textOutput("text2", inline = TRUE))
)
server <- function(input, output, session) {
 output$text <- renderText({
 message('Calcul de "text" ...')
 input$text
 })
 output$text1 <- renderText({
 message('Calcul de "text1" ...')
 input$text
 })
}
shinyApp(ui, server)
```

???

App [`"materials/32-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/32-app/app.R)

---

# Les expressions `reactive`

Pourquoi utiliser des expressions `reactive` ?

* Donne à Shiny des informations additionnelles.  
    $\Rightarrow$ __Limite les répétitions__ de calcul.

* Réduction de la redondance de code.  
    $\Rightarrow$ __Réduction de la complexité__ de l'application.

* Elles peuvent utiliser indifféremment les `input` et `output`.

* Similaire à `input`.  
    $\Rightarrow$ Elles peuvent s'utiliser dans `output`.

* Similaire à `output`.  
    $\Rightarrow$ Elles sont mises à jour au besoin selon `input`.
    
---

# `reactive()` : Exemple 1

```r
ui <- fluidPage(
 fluidRow(
 column(4, 
 "Exemple 1",
 textInput("species1", "Espèce : ", value = "setosa"),
 textInput("col1x", "Axe x : ", value = "Petal.Length"),
 textInput("col1y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point1", height = "250px"))
 ),
 fluidRow(
 column(4, 
 "Exemple 2",
 textInput("species2", "Espèce : ", value = "versicolor"),
 textInput("col2x", "Axe x : ", value = "Petal.Length"),
 textInput("col2y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point2", height = "250px"))
 ),
 fluidRow(
 column(12, plotOutput("point12", height = "250px"))
 )
)
```

???

App [`"materials/33-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/33-app/app.R)

---

# `reactive()` : Exemple 1

???

App [`"materials/33-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/33-app/app.R)

---

# `reactive()` : Exemple 1

```r
server <- function(input, output, session) {
 output$point1 <- renderPlot({
 ggplot(
 data = filter(iris, Species == input$species1), 
 mapping = aes(x = .data[[input$col1x]], y = .data[[input$col1y]])
 ) + geom_point()
 })
 output$point2 <- renderPlot({
 ggplot(
 data = filter(iris, Species == input$species2), 
 mapping = aes(x = .data[[input$col2x]], y = .data[[input$col2y]])
 ) + geom_point()
 })
 output$point12 <- renderPlot({
 p1 <- ggplot(
 data = filter(iris, Species == input$species1), 
 mapping = aes(x = .data[[input$col1x]], y = .data[[input$col1y]])
 ) + geom_point()
 p2 <- ggplot(
 data = filter(iris, Species == !!input$species2), 
 mapping = aes(x = .data[[input$col2x]], y = .data[[input$col2y]])
 ) + geom_point()
 ggarrange(p1, p2, ncol = 2, labels = LETTERS)
 })
}
```

???

App [`"materials/33-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/33-app/app.R)

---

# `reactive()` : Exemple 2

```r
server <- function(input, output, session) {
 ###
 iris1 <- reactive({ filter(iris, Species == input$species1) })
 iris2 <- reactive({ filter(iris, Species == input$species2) })
 ###
 
 output$point1 <- renderPlot({
 ###
 ggplot(iris1(), aes(x = .data[[input$col1x]], y = .data[[input$col1y]])) + 
 ###
 geom_point()
 })
 
 output$point2 <- renderPlot({
 ###
 ggplot(iris2(), aes(x = .data[[input$col2x]], y = .data[[input$col2y]])) + 
 ###
 geom_point()
 })
 
 output$point12 <- renderPlot({
 ###
 p1 <- ggplot(iris1(), aes(x = .data[[input$col1x]], y = .data[[input$col1y]])) + 
 ###
 geom_point()
 ###
 p2 <- ggplot(iris2(), aes(x = .data[[input$col2x]], y = .data[[input$col2y]])) + 
 ###
 geom_point()
 ggarrange(p1, p2, ncol = 2, labels = LETTERS)
 })
}
```

???

App [`"materials/34-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/34-app/app.R)

---

# `reactive()` : Exemple 3

```r
server <- function(input, output, session) {
 ###
 iris_species1 <- reactive({ filter(iris, Species == input$species1) })
 iris_species2 <- reactive({ filter(iris, Species == input$species2) })
 ###
 
 ###
 gg_species1 <- reactive({
 ###
 ggplot(
 ###
 data = iris_species1(), 
 mapping = aes(x = .data[[input$col1x]], y = .data[[input$col1y]])
 ###
 ) + geom_point()
 ###
 })
 gg_species2 <- reactive({
 ###
 ggplot(
 ###
 data = iris_species2(), 
 mapping = aes(x = .data[[input$col2x]], y = .data[[input$col2y]])
 ###
 ) + geom_point()
 ###
 })
 ###
 
 ###
 output$point1 <- renderPlot({ gg_species1() })
 output$point2 <- renderPlot({ gg_species2() })
 ###
 output$point12 <- renderPlot({
 ###
 ggarrange(gg_species1(), gg_species2(), ncol = 2, labels = LETTERS)
 ###
 })
```

???

App [`"materials/35-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/35-app/app.R)

---

# `eventReactive()` & `observeEvent()`

Execution selon un événement, *p. ex.*, un changement de valeur d'un `input`.

```r
something <- eventReactive(eventExpr = ..., valueExpr = ...)

observeEvent(eventExpr = ..., handlerExpr = ...)
```

* `eventExpr`, une expression ou valeur `reactive`.

* `valueExpr`, une expression similaire à celle fournie dans `reactive()`.

* `handlerExpr`, une expression ne retournant rien (`return()`).

---

# Exemple : `reactive()`

```r
library("shiny")

ui <- fluidPage(
 actionButton("update", "Actualiser"),
 textInput("name", "Prénom : ", value = "Mickaël"),
 p("Résultat `reactive` : ", textOutput("hello", inline = TRUE)),
 p("Résultat `eventReactive` : ", textOutput("hello_event", inline = TRUE))
)

server <- function(input, output, session) {
 ###
 text <- reactive({ paste("Bonjour", input$name, "!") })
 ###
 output$hello <- renderText({ text() })
 
 text_event <- eventReactive(input$update, { paste("Bonjour", input$name, "!") })
 output$hello_event <- renderText({ text_event() })
 
 observeEvent(input$update, { message("Mise à jour effectuée !") })
}

shinyApp(ui, server)
```

???

App [`"materials/36-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/36-app/app.R)

---

# Exemple : `eventReactive()`

```r
library("shiny")

server <- function(input, output, session) {
 text <- reactive({ paste("Bonjour", input$name, "!") })
 output$hello <- renderText({ text() })
 
 ###
 text_event <- eventReactive(input$update, { paste("Bonjour", input$name, "!") })
 ###
 output$hello_event <- renderText({ text_event() })
 
 observeEvent(input$update, { message("Mise à jour effectuée !") })
}

shinyApp(ui, server)
```

???

App [`"materials/36-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/36-app/app.R)

---

# Exemple : `observeEvent()`

```r
library("shiny")

server <- function(input, output, session) {
 text <- reactive({ paste("Bonjour", input$name, "!") })
 output$hello <- renderText({ text() })
 
 text_event <- eventReactive(input$update, { paste("Bonjour", input$name, "!") })
 output$hello_event <- renderText({ text_event() })
 
 ###
 observeEvent(input$update, { message("Mise à jour effectuée !") })
 ###
}

shinyApp(ui, server)
```

???

App [`"materials/36-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/36-app/app.R)

---

# Exemple : App

???

App [`"materials/36-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/36-app/app.R)

---

# Exemple : "App 35 v2"

```r
ui <- fluidPage(
 ###
 fluidRow(column(12, actionButton("update", "Actualiser"), offset = 5)),
 ###
 fluidRow(
 column(4, 
 "Exemple 1",
 textInput("species1", "Espèce : ", value = "setosa"),
 textInput("col1x", "Axe x : ", value = "Petal.Length"),
 textInput("col1y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point1", height = "250px"))
 ),
 fluidRow(
 column(4, 
 "Exemple 2",
 textInput("species2", "Espèce : ", value = "versicolor"),
 textInput("col2x", "Axe x : ", value = "Petal.Length"),
 textInput("col2y", "Axe y : ", value = "Sepal.Length")
 ),
 column(8, plotOutput("point2", height = "250px"))
 ),
 fluidRow(
 column(12, plotOutput("point12", height = "250px"))
 )
)
```

???

App [`"materials/37-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/37-app/app.R)

---

# Exemple : "App 35 v2"

```r
server <- function(input, output, session) {
 ###
 iris_species1 <- eventReactive(input$update, { filter(iris, Species == input$species1) })
 iris_species2 <- eventReactive(input$update, { filter(iris, Species == input$species2) })
 ###
 
 ###
 gg_species1 <- eventReactive(input$update, {
 ###
 ggplot(
 ###
 data = iris_species1(), 
 mapping = aes(x = !!sym(input$col1x), y = !!sym(input$col1y))
 # mapping = aes(x = .data[[input$col1x]], y = .data[[input$col1y]])
 ###
 ) + geom_point()
 ###
 })
 gg_species2 <- eventReactive(input$update, {
 ###
 ggplot(
 ###
 data = iris_species2(), 
 mapping = aes(x = !!sym(input$col2x), y = !!sym(input$col2y))
 # mapping = aes(x = .data[[input$col2x]], y = .data[[input$col2y]])
 ###
 ) + geom_point()
 ###
 })
 ###
 
 ###
 output$point1 <- renderPlot({ gg_species1() })
 output$point2 <- renderPlot({ gg_species2() })
 ###
 output$point12 <- renderPlot({
 ###
 ggarrange(gg_species1(), gg_species2(), ncol = 2, labels = LETTERS)
 ###
 })
}
```

???

App [`"materials/37-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/37-app/app.R)

---

# Exemple : "App 35 v2"

???

App [`"materials/37-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/37-app/app.R)

---

# Mise en pratique

* Créez un menu défilant à choix unique listant les jeux de données de `datasets` avec `"iris"` par défaut.

* Affichez le `summary()` et `str()` du jeu de données séléctionné.

* Ajoutez des champs numériques `x` et `y`.

* Générez un graphique avec :

- `x` la position de la colonne en abscisse.
    
    - `y` la position de la colonne en ordonnée.

???

App [`"materials/38-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/38-app/app.R)

---

# Mise en pratique

```r
ui <- fluidPage(theme = "bootstrap.min.css",
 fluidRow(
 column(4, offset = 5,
 selectInput("dataset", label = h3("Datasets"), 
 choices = ls("package:datasets"), 
 selected = "iris"
 )
 )
 ),
 fluidRow(
 column(6,
 h3("Summary"), 
 verbatimTextOutput("summary"),
 h3("Structure"), 
 verbatimTextOutput("structure")
 ),
 column(6,
 h3("Plot"), 
 numericInput("x", label = h4("X-axis column index"), value = 1),
 numericInput("y", label = h4("Y-axis column index"), value = 2),
 plotOutput("plot")
 )
 )
)
```

???

App [`"materials/38-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/38-app/app.R)

---

#  Mise en pratique

???

App [`"materials/38-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/38-app/app.R)

---

# Mise en pratique

???

App [`"materials/38-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/38-app/app.R)

# Contrôle & Validation

```r
req()
validate()
```

* `req()`, contrôle si un `input` a été défini.

* `validate()`, fonctionne comme un `tryCatch`.

```r
ui <- fluidPage(
 textInput("text", "texte : "),
 textOutput("text")
)
```

???

App [`"materials/39-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/39-app/app.R)

---

# Contrôle & Validation

```r
server <- function(input, output, session) {
 output$text <- renderText({
 ###
 req(input$text)
 ###
 paste("Ceci est un texte saisie :", input$text)
 })
}
```

???

App [`"materials/39-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/39-app/app.R)

---

# Contrôle & Validation

```r
server <- function(input, output, session) {
 output$text <- renderText({
 ###
 validate(need(
 expr = input$text == "texte", 
 message = '[NOTE] Le texte saisie est différent de "texte".'
 ))
 ###
 paste("Ceci est un texte saisie :", input$text)
 })
}
```

???

App [`"materials/40-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/40-app/app.R)

---

# Notifications

* `showNotification()` / `removeNotification()`, affiche un encart de texte.

```r
server <- function(input, output, session) {
 output$plot <- renderPlot({
 ###
 id <- showNotification(
 ui = "Importation des données ...", 
 duration = NULL, closeButton = FALSE
 )
 on.exit(removeNotification(id), add = TRUE)
 ###
 Sys.sleep(5)
 plot(1:10)
 })
}
```

???

App [`"materials/41-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/41-app/app.R)

---

# Progression

* `withProgress()` / `setProgress()`, affiche une barre de progression.

```r
server <- function(input, output, session) {
 output$plot <- renderPlot({
 ###
 withProgress(message = "importation des données ...", {
 for (i in seq_len(10)) {
 Sys.sleep(0.2)
 setProgress(i / 10, message = NULL)
 }
 })
 ###
 plot(1:10)
 })
}
```

???

App [`"materials/42-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/42-app/app.R)

---

# Mise en pratique

* Reprenez l'application développé précédemment ([`"materials/38-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/38-app/app.R)).

* Ajoutez les contrôles nécessaires pour éviter les erreurs observées

???

App [`"materials/43-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/43-app/app.R)

---

# Mise en pratique

```r
ui <- fluidPage(theme = "bootstrap.min.css", # or "shinythemes"
 fluidRow(
 column(4, offset = 5,
 selectInput("dataset", label = h3("Datasets"), 
 choices = ls("package:datasets"), 
 selected = "iris"
 )
 )
 ),
 fluidRow(
 column(6,
 h3("Summary"), 
 verbatimTextOutput("summary"),
 h3("Structure"), 
 verbatimTextOutput("structure")
 ),
 column(6,
 h3("Plot"), 
 numericInput("x", label = h4("X-axis column index"), value = 1),
 numericInput("y", label = h4("Y-axis column index"), value = 2),
 plotOutput("plot")
 )
 )
)
```

???

App [`"materials/43-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/43-app/app.R)

---

# Mise en pratique

```r
need_numeric <- function(data, input) {
 need(
 expr = is.numeric(data[, input]), 
 message = paste("Column", input, "is not a numeric!")
 )
}

need_in <- function(data, input) {
 need(
 expr = all(input %in% 1:ncol(data)), 
 message = paste("Column", input, "is not available!")
 )
}
```

???

App [`"materials/43-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/43-app/app.R)

---

# Mise en pratique

```r
server <- function(input, output, session) { 
 dataset <- reactive({ get(input$dataset, "package:datasets") })
 output$summary <- renderPrint({ summary(dataset()) })
 output$structure <- renderPrint({ str(dataset()) })
 output$plot <- renderPlot({
 ###
 validate(need(
 expr = inherits(dataset(), "data.frame"), 
 message = "Not a data.frame!"
 ))
 validate(need_in(dataset(), c(input$x, input$y)))
 validate(
 need_numeric(dataset(), input$x),
 need_numeric(dataset(), input$y)
 )
 ###
 plot(dataset()[, input$x], dataset()[, input$y]) 
 })
}
```

???

App [`"materials/43-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/43-app/app.R)

---

# Mise en pratique

???

App [`"materials/43-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/43-app/app.R)

# Générer des éléments `ui`

```r
ui <- fluidPage(
 textInput("lastname", "Nom :"),
 ###
 uiOutput("firstname"),
 ###
 uiOutput("age")
)

server <- function(input, output, session) {
 ###
 output$firstname <- renderUI({
 textInput("firstname", "Prénom :")
 })
 ###
 output$age <- renderUI({
 numericInput("age", "Age :", value = 0)
 })
}
```

???

App [`"materials/44-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/44-app/app.R)

---

# Affichage conditionnel de `ui`

```r
ui <- fluidPage(
 fluidRow(
 column(6, textInput("lastname", "Nom :"), uiOutput("firstname")),
 column(6, uiOutput("input_age"), uiOutput("age"))
 )
)
server <- function(input, output, session) {
 ###
 output$firstname <- renderUI({
 req(input$lastname)
 textInput("firstname", "Prénom :")
 })
 output$input_age <- renderUI({
 req(input$firstname)
 selectInput("type", "type", c("slider", "numeric"))
 })
 output$age <- renderUI({
 req(input$type, input$firstname)
 if (input$type == "slider") {
 sliderInput("dynamic", "Age :", value = 0, min = 0, max = 99)
 } else {
 numericInput("age", "Age :", value = 0) 
 }
 })
 ###
}
```

???

App [`"materials/45-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/45-app/app.R)

---

# Affichage conditionnel de `ui`

```r
ui <- fluidPage(
 fluidRow(
 column(6, textInput("lastname", "Nom :"), uiOutput("firstname")),
 column(6, uiOutput("input_age"), uiOutput("age"))
 )
)
server <- function(input, output, session) {
 output$firstname <- renderUI({
 req(input$lastname)
 textInput("firstname", "Prénom :")
 })
 output$input_age <- renderUI({
 req(input$firstname)
 selectInput("type", "type", c("slider", "numeric"))
 })
 output$age <- renderUI({
 req(input$type, input$firstname)
 ###
 if (input$type == "slider") {
 sliderInput("age", "Age :", value = isolate(input$age), min = 0, max = 99)
 } else {
 numericInput("age", "Age :", value = isolate(input$age)) 
 }
 ###
 })
}
```

???

App [`"materials/46-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/46-app/app.R)

---

# Mettre à jour des `input`

```r
ui <- fluidPage(
 numericInput("min", "Minimum", 0), numericInput("max", "Maximum", 3),
 ###
 uiOutput("n")
 ###
)
server <- function(input, output, session) {
 output$n <- renderUI({
 ###
 sliderInput("n", "n", min = input$min, max = input$max, value = 1)
 ###
 })
}
```

???

App [`"materials/47-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/47-app/app.R)

---

# Mettre à jour des `input`

```r
ui <- fluidPage(
 numericInput("min", "Minimum", 0), numericInput("max", "Maximum", 3),
 ###
 sliderInput("n", "n", min = 0, max = 3, value = 1)
 ###
)
server <- function(input, output, session) {
 ###
 observeEvent(input$min, { updateNumericInput(session, "n", min = input$min) }) 
 observeEvent(input$max, { updateNumericInput(session, "n", max = input$max) })
 ###
}
```

???

App [`"materials/48-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/48-app/app.R)

---

# Mise en pratique

* Générez l'application suivante.

???

App [`"materials/49-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/49-app/app.R)

App [`"materials/50-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/50-app/app.R)

App [`"materials/51-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/51-app/app.R)

App [`"materials/52-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/51-app/app.R)

---

# Mise en pratique : Code 1

```r
library("shiny")
library("dplyr")
ui <- fluidPage(
 column(4,
 sliderInput("Sepal.Length", "Sepal.Length", 
 min = min(iris$Sepal.Length), max = max(iris$Sepal.Length), 
 value = range(iris$Sepal.Length)
 ),
...
 ),
 column(8, tableOutput("iris"))
)
server <- function(input, output, session) {
 output$iris <- renderTable({
 filter(iris,
 between(Sepal.Length, input$Sepal.Length[1], input$Sepal.Length[2]),
 between(Sepal.Width, input$Sepal.Width[1], input$Sepal.Width[2]),
 between(Petal.Length, input$Petal.Length[1], input$Petal.Length[2]),
 between(Petal.Width, input$Petal.Width[1], input$Petal.Width[2]),
 Species %in% input$Species
 )
 })
}
shinyApp(ui, server)
```

???

App [`"materials/49-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/49-app/app.R)

---

# Mise en pratique : Essai app 1

???

App [`"materials/49-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/49-app/app.R)

---

# Mise en pratique : Code 2

```r
make_ui <- function(data, var) {
 x <- data[, var]
 if (is.numeric(x)) {
 min_max <- range(x, na.rm = TRUE)
 sliderInput(
 inputId = var,
 label = var, 
 min = min_max[1], 
 max = min_max[2], 
 value = min_max
 )
 } else if (is.character(x) | is.factor(x)) {
 unique_x <- unique(x)
 selectInput(
 inputId = var,
 label = var, 
 choices = unique_x, 
 selected = unique_x, 
 multiple = TRUE
 )
 } else {
 NULL # default
 }
}
```

???

App [`"materials/50-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/50-app/app.R)

---

# Mise en pratique : Code 2

```r
library("shiny")
library("dplyr")
ui <- fluidPage(
 column(4,
 make_ui(iris, "Sepal.Length"),
 make_ui(iris, "Sepal.Width"),
 make_ui(iris, "Petal.Length"),
 make_ui(iris, "Petal.Width"),
 make_ui(iris, "Species")
 ),
 column(8, tableOutput("iris"))
)
server <- function(input, output, session) {
 output$iris <- renderTable({
 filter(.data = iris,
 between(Sepal.Length, input$Sepal.Length[1], input$Sepal.Length[2]),
 between(Sepal.Width, input$Sepal.Width[1], input$Sepal.Width[2]),
 between(Petal.Length, input$Petal.Length[1], input$Petal.Length[2]),
 between(Petal.Width, input$Petal.Width[1], input$Petal.Width[2]),
 Species %in% input$Species
 )
 })
}
shinyApp(ui, server)
```

???

App [`"materials/50-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/50-app/app.R)

---

# Mise en pratique : Essai app 2

???

App [`"materials/50-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/50-app/app.R)

---

# Mise en pratique : Code 3

???

App [`"materials/51-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/51-app/app.R)

---

# Mise en pratique : Code 3

```r
filter_var <- function(data_var, input_var) {
 if (is.numeric(data_var)) {
 !is.na(data_var) & # dplyr::between
 data_var >= input_var[1] & 
 data_var <= input_var[2]
 } else if (is.character(data_var) | is.factor(data_var)) {
 data_var %in% input_var
 } else {
 TRUE # default
 }
}
```

???

App [`"materials/51-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/51-app/app.R)

---

# Mise en pratique : Code 3

```r
library("shiny")
library("dplyr")
library("purrr")

ui <- fluidPage(
 column(4, map(colnames(iris), ~ make_ui(iris, .x))),
 column(8, tableOutput("iris"))
)

server <- function(input, output, session) {
 output$iris <- renderTable({
 vals <- map(colnames(iris), ~ filter_var(iris[[.x]], input[[.x]]))
 iris[reduce(vals, `&`), ]
 })
}

shinyApp(ui, server)
```

???

App [`"materials/51-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/51-app/app.R)

---

# Mise en pratique : Essai app 3

???

App [`"materials/51-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/51-app/app.R)

---

# Mise en pratique : Code 4

???

App [`"materials/52-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/52-app/app.R)

---

# Mise en pratique : Code 4

???

App [`"materials/52-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/52-app/app.R)

---

# Mise en pratique : Code 4

```r
ui <- fluidPage(
 fluidRow(column(4, offset = 5,
 selectInput("dataset", label = h3("Datasets"), 
 choices = ls("package:datasets"), 
 selected = "iris"
 )
 )),
 fluidRow(
 column(4, uiOutput("ui")),
 column(8, tableOutput("iris"))
 )
)
server <- function(input, output, session) {
 datasets <- reactive({get(input$dataset, "package:datasets")})
 output$iris <- renderTable({
 validate(need(inherits(datasets(), "data.frame"), 'Not a "data.frame"'))
 vals <- map(colnames(datasets()), ~ filter_var(datasets()[[.x]], input[[.x]]))
 datasets()[reduce(vals, `&`), ]
 })
 output$ui <- renderUI({
 validate(need(inherits(datasets(), "data.frame"), 'Not a "data.frame"'))
 map(colnames(datasets()), ~ make_ui(datasets(), .x))
 })
}
```

???

App [`"materials/52-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/52-app/app.R)

---

# Mise en pratique : Essai app 4

???

App [`"materials/52-app"`](https://github.com/mcanouil/rshiny/tree/main/materials/52-app/app.R)

# Shiny & Rmarkdown

_Note : La spécification de `app.Rmd` est obligatoire ici avec `rmarkdown::run()`._

* `rmarkdown::html_document`

```r
rmarkdown::run("materials/53-app/app.Rmd")
```

* `flexdashboard::flex_dashboard`

```r
rmarkdown::run("materials/54-app/app.Rmd")
```

* `rmarkdown::ioslides_presentation`

```r
rmarkdown::run("materials/55-app/app.Rmd")
```

* ...

# Ressources

* [shiny](https://shiny.rstudio.com/)

* ["maining Shiny" (en cours d'écriture)](https://maining-shiny.org/)

* [shinytest](https://rstudio.github.io/shinytest/)

* [DT](https://rstudio.github.io/DT/)

* [Blog Rstudio](https://blog.rstudio.com/categories/shiny)

* [Groupe des Utilisateurs de R](http://forums.cirad.fr/logiciel-R/)

* [Stack Overflow](https://stackoverflow.com/questions/tagged/r)

* [R Studio Community](https://community.rstudio.com/)

---
class: part-slide

# <img src = "data:image/png;base64,#https://avatars1.githubusercontent.com/u/8896044" height = "150px" id = "picture" />

.center[

<a href = "http://m.canouil.fr" target = "_blank"> m.canouil.fr</a>

.column[
<a href = "https://www.linkedin.com/in/mickael-canouil/" target = "_blank"> mickael-canouil</a>
]
.column[
<a href = "https://github.com/mcanouil/" target = "_blank"> mcanouil</a>
]
.column[
<a href = "https://twitter.com/mickaelcanouil/" target = "_blank"> @mickaelcanouil</a>
]

]